home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / gsdbloo.exe / GS_DBTBL.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-27  |  10KB  |  370 lines
  1. UNIT GS_DBTbl;
  2. {------------------------------------------------------------------------------
  3.                               DBase Table Maker
  4.  
  5.        GS_DBTBL Copyright (c)  Richard F. Griffin
  6.  
  7.        1 February 1991
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        Routines to build tables from dBase files.  Also allows pick
  14.        option from created tables.
  15.  
  16. Changes:
  17.  
  18.         7 Apr 91 - Modified Build_dBTabl to insert the 'APPEND' at the
  19.                    end of the table, if applicable.  This was previously
  20.                    done in Pick_dBTabl, which caused Build_dBTabl to miss
  21.                    doing this if called separately.
  22.  
  23.                    Modified Find_dBTabl and FindNext_dBTabl to avoid testing
  24.                    the 'APPEND' entry (if there).  A test on the 'APPEND'
  25.                    entry can cause a match against a blank field if there
  26.                    are sufficient leading spaces in the 'APPEND' entry.
  27.  
  28.         1 Aug 91 - Added SortAsnd flag to determine direction of table sort.
  29.                    Default is ascending sort;
  30.  
  31. ------------------------------------------------------------------------------}
  32.  
  33. INTERFACE
  34. {$D-}
  35.  
  36. USES
  37.    Crt,
  38.    Dos,
  39.    GS_Error,
  40.    GS_KeyI,
  41.    GS_dBase,
  42.    GS_Winfc,
  43.    GS_Pick,
  44.    GS_Strng;
  45.  
  46.  
  47. type
  48.  
  49.  
  50.    dBTabl_Arry_Fld = array [0..MaxInt] of byte;
  51.    dBTabl_Pick_Obj = Object
  52.                       dbas     : ^GS_dBase_DB;      {Object to refer to}
  53.                       Pick_Win : GS_Wind_Objt;      {Window object for menu}
  54.                       Tabl     : ^dBTabl_Arry_Fld;  {Menu table on the heap}
  55.                       Sz_Tab   : longint;           {Size of table}
  56.                       siz      : integer;           {Size of a table entry}
  57.                       recs     : longint;           {Number records in table}
  58.                       Sel_Item : longint;           {Last entry number selected}
  59.                       Scn_Key  : string;            {Holds select key formula}
  60.                       AddRecOk : boolean;           {True allows appending}
  61.                       AddRec   : boolean;           {True if append selected}
  62.                       SortAsnd : boolean;           {True if ascending sort}
  63.  
  64.                       procedure Append_dbTabl(tf : boolean);
  65.                       procedure Init_dBTabl(var Fil : GS_dBase_DB; stg : string;
  66.                                      x1,y1,x2,y2,tx,bg,fg,itx,ibg : integer);
  67.                       procedure Reset_dBTabl;
  68.                       procedure Build_dBTabl(zfld : string);
  69.                       function  Choose_dBTabl : boolean;
  70.                       function  Pick_dBTabl(zfld : string) : boolean;
  71.                       function  Find_dBTabl(pcnd : string) : boolean;
  72.                       function  FindNext_dBTabl(pcnd : string) : boolean;
  73.                       function  Scan_dBTabl(pfld, pcnd, zfld : string)
  74.                                                              : boolean;
  75.                    end;
  76.  
  77.  
  78. implementation
  79.  
  80.  
  81. var
  82.    File_Win     :  GS_Wind_Objt;
  83.    ap           :  string[10];
  84.  
  85.  
  86. procedure dBTabl_Pick_Obj.Append_dBTabl(tf : boolean);
  87. begin
  88.    AddRecOK := tf;
  89.    AddRec := false;
  90.    Reset_dBTabl;
  91. end;
  92.  
  93.  
  94.  
  95. procedure dBTabl_Pick_Obj.Init_dBTabl(var Fil : GS_dBase_DB; stg : string;
  96.                                       x1,y1,x2,y2,tx,bg,fg,itx,ibg : integer);
  97. begin
  98.    ap := '- APPEND -';
  99.    dBas := @Fil;
  100.    Tabl := nil;
  101.    Pick_Win.InitWin(x1,y1,x2,y2,tx,bg,tx,itx,ibg,true,stg,true);
  102.    Scn_Key := '^^^^';
  103.    Sel_Item := 1;
  104.    AddRecOK := false;
  105.    AddRec := false;
  106.    SortAsnd := true;
  107. end;
  108.  
  109. procedure dBTabl_Pick_Obj.Reset_dBTabl;
  110. begin
  111.    if Tabl <> nil then FreeMem(Tabl,Sz_Tab);
  112.    Tabl := nil;
  113.    Scn_Key := '^^^^';
  114.    Sel_Item := 1;
  115. end;
  116.  
  117. procedure dBTabl_Pick_Obj.Build_dBTabl(zfld : string);
  118. var
  119.    l : longint;
  120.    t : string[127];
  121.    ia : pointer;
  122.    v  : integer;
  123.    ta : byte;
  124.    ft : char;
  125. begin
  126.    Reset_dBTabl;
  127.    zfld := AllCaps(zfld);
  128.    Scn_Key := zfld;
  129.    with dBas^ do
  130.    begin
  131.       ia := dbfNdxActv;
  132.       dbfNdxActv := nil;             {Temporarily turn off any index}
  133.       GetRec(Top_Record);
  134.       t := Formula(zfld,ft);
  135.       l := 0;
  136.       recs := dBas^.NumRecs;
  137.       if AddRecOK then inc(recs);
  138.       siz := length(t) + 5;
  139.       Sz_Tab := recs * siz;
  140.       GetMem(Tabl,Sz_Tab);
  141.       while (not File_EOF) do
  142.       begin
  143.          t := Formula(zfld,ft);
  144.          move(t,Tabl^[l*siz],siz-4);
  145.          move(RecNumber,Tabl^[(l*siz)+siz-4],4);
  146.          inc(l);
  147.          GetRec(Next_Record);
  148.       end;
  149.       dbfNdxActv := ia;
  150.       GetRec(Top_Record);          {Puts DBF and NDX back in sync}
  151.       recs := l;
  152.       GS_Pick_Item_Sort(Tabl^,siz,recs,SortAsnd);
  153.       if AddRecOK then
  154.       begin
  155.          inc(recs);
  156.          v := siz-5;
  157.          FillChar(t[1],v,' ');
  158.          t[0] := chr(v);
  159.          Insert(ap,t,succ((v - 10) div 2));
  160.          System.Delete(t,v+1,10);
  161.          move(t,Tabl^[(recs-1)*siz],siz-4);
  162.       end;
  163.    end;
  164. end;
  165.  
  166.  
  167. function dBTabl_Pick_Obj.Choose_dBTabl : boolean;
  168. var
  169.    i,
  170.    l : longint;
  171.    c1: char;
  172.    v : integer;
  173. begin
  174.    AddRec := false;
  175.    if recs > 0 then
  176.       i := GS_Pick_Row_Item(Tabl^,siz,recs, Sel_Item)
  177.    else
  178.    begin
  179.       gotoxy((((lo(WindMax)-lo(WindMin))-4) div 2)+1,
  180.              ((hi(WindMax)-hi(WindMin)) div 2)+1);
  181.       write('Empty');
  182.       repeat
  183.          c1 := GS_KeyI_GetKey;
  184.       until c1 in [#13,#27];
  185.       i := 0;
  186.    end;
  187.    if i > 0 then
  188.    begin
  189.        Choose_dBTabl := true;
  190.        if (AddREcOK) and (i = recs) then
  191.           AddRec := true
  192.        else
  193.        begin
  194.           move(Tabl^[((i-1)*siz)+siz-4],l,4);
  195.           dBas^.GetRec(l);
  196.        end;
  197.        Sel_Item := i;
  198.    end else Choose_dBTabl := false;
  199. end;
  200.  
  201. function dBTabl_Pick_Obj.Pick_dBTabl(zfld : string) : boolean;
  202. var
  203.    t  : string[127];
  204.    v  : integer;
  205.    ta : byte;
  206. begin
  207.    Pick_Win.SetWin;
  208.    AddRec := false;
  209.    zfld := AllCaps(zfld);
  210.    if Scn_Key <> zfld then Reset_dBTabl;
  211.    Scn_Key := zfld;
  212.    if Tabl = nil then
  213.    begin
  214.       gotoxy((((lo(WindMax)-lo(WindMin))-6) div 2)+1,
  215.               ((hi(WindMax)-hi(WindMin)) div 2)+1);
  216.       ta := TextAttr;
  217.       TextAttr := TextAttr + 128;
  218.       write('Working');
  219.       TextAttr := ta;
  220.       Build_dBTabl(zfld);
  221.    end;
  222.    ClrScr;
  223.    Pick_dBTabl := Choose_dBTabl;
  224.    Pick_Win.RelWin;
  225. end;
  226.  
  227. function dBTabl_Pick_Obj.Find_dBTabl(pcnd : string) : boolean;
  228. var
  229.    recsa,
  230.    i,
  231.    l : longint;
  232.    m,
  233.    s : string;
  234.    mtch : boolean;
  235. begin
  236.    mtch := false;
  237.    m := AllCaps(pcnd);
  238.    recsa := recs;
  239.    if AddRecOK then dec(recsa);
  240.    if recsa > 0 then
  241.    begin
  242.       i := 0;
  243.       repeat
  244.          move(Tabl^[i*siz],s,siz-4);
  245.          s[0] := m[0];
  246.          if (AllCaps(s) = m) then mtch := true;
  247.          inc(i);
  248.       until (i = recsa) or (mtch);
  249.       if not mtch then i := 0;
  250.    end
  251.    else
  252.    begin
  253.       i := 0;
  254.    end;
  255.    if i > 0 then
  256.    begin
  257.        Find_dBTabl := true;
  258.        move(Tabl^[((i-1)*siz)+siz-4],l,4);
  259.        dBas^.GetRec(l);
  260.        Sel_Item := i;
  261.    end else Find_dBTabl := false;
  262. end;
  263.  
  264. function dBTabl_Pick_Obj.FindNext_dBTabl(pcnd : string) : boolean;
  265. var
  266.    recsa,
  267.    i,
  268.    l : longint;
  269.    m,
  270.    s : string;
  271. begin
  272.    recsa := recs;
  273.    if AddRecOK then dec(recsa);
  274.    m := AllCaps(pcnd);
  275.    if (recsa > 0) and (Sel_Item < recsa) then
  276.    begin
  277.       i := Sel_Item;
  278.       move(Tabl^[i*siz],s,siz-4);
  279.       s[0] := m[0];
  280.       inc(i);
  281.       if AllCaps(s) <> m then i := 0;
  282.    end
  283.    else
  284.    begin
  285.       i := 0;
  286.    end;
  287.    if i > 0 then
  288.    begin
  289.        FindNext_dBTabl := true;
  290.        move(Tabl^[((i-1)*siz)+siz-4],l,4);
  291.        dBas^.GetRec(l);
  292.        Sel_Item := i;
  293.    end else FindNext_dBTabl := false;
  294. end;
  295.  
  296. function dBTabl_Pick_Obj.Scan_dBTabl(pfld, pcnd, zfld : string) : boolean;
  297. var
  298.    m,
  299.    s  : string;
  300.    t  : string[127];
  301.    v  : integer;
  302.    ta : byte;
  303.    ia : pointer;
  304.    l  : longint;
  305.    ft : char;
  306. b